COMMENT ⊗   VALID 00021 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	TITLE BIN	BODY INTERSECTION - 7 MARCH 1973.
C00005 00003	comment/
C00008 00004	SUBR(WITH3D)FACE,XWC,YWC,ZWC TEST FOR LOCUS WITHIN FACE 3D.
C00011 00005	SUBR(COMPFE)FACE,EDGE	COMPARE FACE EDGE 3D FOR PIERCING.
C00014 00006	SUBR(VNEXT)F,E.,V
C00016 00007	SUBR(OTHERV)F,V1
C00018 00008	SUBR(BTRACE)V0  TRACE THE BODY OF INTERSECTION STARTING FROM V0.
C00020 00009	L1:
C00022 00010	SUBR(FTRACE)F.		FACE TRACE.
C00024 00011	MAKE WASP FACE.
C00025 00012	SUBR(BIN,B1,B2)		COMPUTE BODY OF INTERSECTION.
C00028 00013	SUBR(SOLANG)V 		SOLID ANGLE OF A SURFACE VERTEX.
C00030 00014	SUBR(KLSURV)B		KILL SURFACE VERTICES OF A BODY.
C00033 00015	SUBR(QHOLE)V		 DETECT AND PYRAMID POTENTIAL PIERCE HOLES.
C00035 00016	SUBR(BUN)B1,B2			BODY UNION.
C00036 00017	SUBR(MKCVEX)F 		MAKE CONVEX.
C00038 00018		GO L6
C00040 00019	SCAN FACE1'S PERIMETER VERT1 TO VERT3.
C00042 00020	SUBR(ESLURP,BODY)	REMOVE UNNECESSARY EDGES.
C00045 00021	DIAGONOSTIC DISPLAY.
C00046 ENDMK
C⊗;
TITLE BIN	BODY INTERSECTION - 7 MARCH 1973.

	EXTERN VCW,VCCW,ECCW,VERIFY
	EXTERN FACOEF,ESPLIT,INVERT
	EXTERN GLUEE,LINKED,MKEV,MKFE
	EXTERN MKB,MKF,MKV,MKFRAME
	EXTERN OTHER,EVERT,FCCW,FCW
	EXTERN DPYBUF,DPYSET,DPYOUT
	EXTERN FDPY,EDPY,VDPY
	EXTERN QFEV,KLFE,ECOEF,ECW

	↓SURBIT←←1B2	;VERTEX ON SURFACE.
	↓OKBIT←←2B2

	DEFINE QFACE(Q,V){CDR Q,7(V)}
	DEFINE QFACE.(Q,V){DAP Q,7(V)}

	DEFINE NAF (Q,E){CAR Q,-1(E)}
	DEFINE NAF.(Q,E){DIP Q,-1(E)}

	DEFINE PAF (Q,E){CDR Q,-1(E)}
	DEFINE PAF.(Q,E){DAP Q,-1(E)}

	DEFINE JALT(A,B){ALT. A,B↔ALT. B,A}
	DEFINE JALTV(V,V.){ALT. V,V.↔ALT. V.,V
	SLACI XWC(V)↔LAPI XWC(V.)↔BLT ZWC(V.)}

	DECLARE{FNEXT,ENEXT}
comment/

	Although this code performs body union and body  subtraction;
all  the  nomensclature  will  be in terms of body intersection, BIN.
Pure BIN takes two operand bodies and "copies" off them  a  resultant
body  of their intersection. This requires marking and splitting some
of faces and edges, however the operand bodies  can  be  restored  to
their  original  selves by applying KLTMPS; or if the operands are no
longer needed they must be explicitly killed.

1. Face-Edge Compare; Make piercing vertices.

	All the faces of each operand is compared with all the edges
of the other. When a edge passes thru a face, the edge is spilt and
a "surface vertex" or "SURV" is placed at the piercing point. The
QFACE of the SURV points at the face pierce.

2. Face Hole Suppression.

3. Body and Face Tracing.

4. Dealing with bodies of parts.

5. Convex face making.


LINKS LEFT BY BIN.

	ALT  of  all result vertices points to a vertex in one or the
other operand. ALT of a result edge is zero, if the edge  was  formed
by  two  conflicting  faces in the operands, the particular faces are
pointed at by the NAF and PAF links. A non-zero ALT of a result edge,
points  at  an  edge  of one operand that was buried inside the solid
body of the other operand, and is thus called an interior edge.
ALT of all faces of the result points at the corresponding face of
one of the operands.

/
SUBR(WITH3D)FACE,XWC,YWC,ZWC; TEST FOR LOCUS WITHIN FACE 3D.
COMMENT ⊗------------------------------------------------------------
⊗
	ACCUMULATORS{FLG,V,E,F,DX1,DY1,DZ1,Q1,DX2,DY2,DZ2,Q2,E0}
	
;SELECT COMPONENT BY LARGEST FACE COEFFICIENT.
	LAC F,ARG4
	LACM 1,AA(F)
	LACM 2,BB(F)
	LACM 3,CC(F)
	LACI C0↔CAMG 1,2↔GO[
	LACI C1↔CAMG 2,3↔LACI C2↔GO .+3]
		CAMG 1,3↔LACI C2↔DAP CASE

;FIRST EDGE OF THE FACE.
	DOM FLG
	PED E,F↔DAC E,E0↔SETQ(V,{VCW,E,F})
	LAC DX2,XWC(V)↔FSB DX2,ARG3
	LAC DY2,YWC(V)↔FSB DY2,ARG2
	LAC DZ2,ZWC(V)↔FSB DZ2,ARG1

L1:	LAC DX1,DX2
	LAC DY1,DY2
	LAC DZ1,DZ2
	LAC Q1,Q2

;NEXT EDGE OF THE FACE.
	SETQ(V,{VCCW,E,F})
	SETQ(E,{ECCW,E,F})
	LAC DX2,XWC(V)↔FSB DX2,ARG3
	LAC DY2,YWC(V)↔FSB DY2,ARG2
	LAC DZ2,ZWC(V)↔FSB DZ2,ARG1

;COMPUTE A COMPONENT OF THE CROSS-PRODUCT.

CASE:	GO
C0:	LAC 0,DY2↔FMP 0,DZ1↔LAC 1,DY1↔FMP 1,DZ2↔GO C3
C1:	LAC 0,DX1↔FMP 0,DZ2↔LAC 1,DX2↔FMP 1,DZ1↔GO C3
C2:	LAC 0,DX2↔FMP 0,DY1↔LAC 1,DX1↔FMP 1,DY2
C3:	FSB 0,1↔DAC Q2
	JUMPE 0,L3		;LOCUS IS ON A FUCKING EDGE !

;DETECT SIGN CHANGE.

	AOJE FLG,L2		;JUMP ON FIRST TIME THRU.
	XOR Q1↔JUMPL POP4J.	;NO SKIP RETURN FALSE.
L2:	CAME E,E0↔GO L1
	AOS(P)↔POP4J		;SKIP RETURN TRUE - LOCUS IS WITHIN.
L3:	LAC DX1↔FMP DX2			;COSINE.
	LAC 1,DY1↔FMP 1,DY2↔FAD 0,1
	LAC 1,DZ1↔FMP 1,DZ2↔FAD 0,1
	SKIPGE↔AOS(P)↔POP4J		;SKIP RETURN TRUE - LOCUS IS WITHIN.
ENDR WITH3D;3/7/73(BGB)----------------------------------------------
SUBR(COMPFE)FACE,EDGE	;COMPARE FACE EDGE 3D FOR PIERCING.
COMMENT .------------------------------------------------------------
    V2 ← PVT    ⊗	Q2 < K	   ABOVE F,
                | ENEW
            ____|_____________________
           /    |                    /
          /     ⊗ V      FACE F     /
         /_________________________/
		|
		|  E
    V1 ← NVT	⊗ 	Q1 > K     BELOW-F.
	ACCUMULATORS{X,Y,Z,V1,V2,E,F}

;CHECK ARGUMENTS FOR FRESHNESS.
	LAC E,ARG1↔LAC F,ARG2
	NVT V1,E↔PVT V2,E
	QFACE 1,V1↔CAMN 1,F↔POP0J
	QFACE 1,V2↔CAMN 1,F↔POP0J

;DIRECTED DISTANCE V1 FROM FACE.
	LAC 0,AA(F)↔FMP 0,XWC(V1)
	LAC 1,BB(F)↔FMP 1,YWC(V1)↔FAD 0,1
	LAC 1,CC(F)↔FMP 1,ZWC(V1)↔FAD 0,1↔DAC Q1#

;DIRECTED DISTANCE V2 FROM FACE.
	LAC 0,AA(F)↔FMP 0,XWC(V2)
	LAC 1,BB(F)↔FMP 1,YWC(V2)↔FAD 0,1
	LAC 1,CC(F)↔FMP 1,ZWC(V2)↔FAD 0,1↔DAC Q2#

;DOES EDGE PASS THRU THE PLANE OF THIS FACE.
	LAC KK(F)
	CAMG Q1↔GO .+3↔CAMLE Q2↔POP0J
	CAML Q1↔GO .+3↔CAMGE Q2↔POP0J
	FSB 0,Q1↔LAC 1,Q2↔FSB 1,Q1
	FDVR 0,1↔SKIPL↔CAMLE[1.0]↔POP0J↔DAC 1

;SOLVE FOR PLANE PIERCING LOCUS.
	LAC X,XWC(V1)↔LAC XWC(V2)↔FSB X↔FMP 1↔FADM X
	LAC Y,YWC(V1)↔LAC YWC(V2)↔FSB Y↔FMP 1↔FADM Y
	LAC Z,ZWC(V1)↔LAC ZWC(V2)↔FSB Z↔FMP 1↔FADM Z
	CALL(WITH3D,F,X,Y,Z)↔POP0J
	LAC E,ARG1↔LAC F,ARG2↔ADD P,[XWD 4,4]

;MAKE FACE PIERCING POINT.
	LAC KK(F)↔CAMLE Q1↔GO[CALL(INVERT,E)↔GO .+1]
	CALL(ESPLIT,E)↔MARK 1,SURBIT
	POP P,ZWC(1)↔POP P,YWC(1)↔POP P,XWC(1)↔POP P,0
	QFACE. 0,1↔LAC 2,ARG1↔PED. 2,1↔POP0J
ENDR COMPFE;3/7/73---------------------------------------------------
SUBR(VNEXT)F,E.,V
COMMENT ⊗------------------------------------------------------------
⊗↔	ACCUMULATORS{F,E.,V}
	LAC F,ARG3
	LAC E.,ARG2
	LAC V,ARG1

;INTERIOR TO INTERIOR.
	ALT 1,E.↔DAC 1,ENEXT
	TEST V,SURBIT↔GO[	;SKIP WHEN VERTEX ON SURFACE.
		SETQ(ENEXT,{ECCW,ENEXT,F})
		CALL(VCCW,ENEXT,F)↔POP3J]

;SURFACE TO INTERIOR.
	QFACE 0,V↔DAC 0,FNEXT
	CAME F,FNEXT↔JUMPE 1,[
		PED 1,V↔DAC 1,ENEXT
		CALL(OTHER,1,V)↔POP3J]

;INTERIOR TO SURFACE.
	DZM ENEXT↔CAME F,FNEXT↔GO[
		CALL(OTHERV,F,V)↔POP3J]

;SURFACE TO SURFACE.
	PAF 1,E.↔CAMN 1,F↔NAF 1,E.
	PED 0,V↔CALL(OTHER,0,1)↔DAC 1,FNEXT
	CALL(OTHERV,FNEXT,V)↔POP3J
ENDR VNEXT;3/8/73(BGB)-----------------------------------------------
SUBR(OTHERV)F,V1
COMMENT; OTHER PIERCING VERTEX MANDALA
  F1 PIERCES F2 AT V2 CASE.	  F2 PIERCES F1 AT V2 CASE.
            ______________                ________
           |              |              |        |
           |   F2         |              |   F2   |
     ______|.........     |        ______|........|_____
    |      ↓        .     |       |      ↓        ↓     |
    | F1   ⊗V1      ⊗V2   |       | F1   ⊗V1      ⊗V2   |
    |_______________↑     |       |_____________________|
           |              |              |        |
           |______________|              |________|     ;

	ACCUMULATORS{F1,F2,V1,E,E0}
	LAC F2,ARG2
	LAC V1,ARG1
	QFACE F1,V1

;DOES F1 PIERCE F2 AT V2.
	PED E,F1↔DAC E,E0
L1:	CALL(VCCW,E,F1)
	QFACE 0,1
	CAMN 0,F2↔POP2J
	SETQ(E,{ECCW,E,F1})
	CAME E,E0↔GO L1

;DOES F2 PIERCE F1 AT V2.
	PED E,F2↔DAC E,E0
L2:	CALL(VCCW,E,F2)
	CAMN 1,V1↔GO .+4
	QFACE 0,1
	CAMN 0,F1↔POP2J
	SETQ(E,{ECCW,E,F2})
	CAME E,E0↔GO L2
	FATAL(OTHERV)
ENDR OTHERV;3/8/73(BGB)----------------------------------------------
SUBR(BTRACE)V0  TRACE THE BODY OF INTERSECTION STARTING FROM V0.
COMMENT ⊗------------------------------------------------------------
⊗↔	GO L0
	ACCUMULATORS{B,F,F.,E,E.,V,V.,V0}
	DECLARE{BODYIN,FACE,FACE.,EDGE,EDGE.,VERT,VERT.,VERT0}

;MAKE THE BODY NODE.
L0:	LAC 1,ARG1↔PED 1,1↔CCW 1,1	;BODY OF V0.
	SETQ(BODYIN,{MKB,1})
	CALL(MKF,BODYIN)
	CALL(MKV,BODYIN)
	CALL(MKFRAME)
	LAC B,BODYIN
	FRAME. 1,B

;FIRST EDGE OF THE BODY AND ALL ITS FRIENDS.
	LAC V0,ARG1
	PVT V.,B
	JALTV(V0,V.)
	PED E,V0
	SETQ(F,{FCCW,E,V0})
	PFACE F.,B
	JALT(F,F.)
	SETQ(V,{VCCW,E,F})
	LAC[XWD B,BODYIN]↔BLT VERT0	;SAVE AC'S.
	SETQ(V.,{MKEV,F.,V.})↔DAC V.,VERT.
	LAC V,VERT↔LAC E,EDGE
	JALTV(V,V.)
	PED E.,V.↔DAC E.,EDGE.
	JALT(E,E.)
	CAR(E)↔DIP(E.)		;MOVE TYPE BITS.			**
L1:
	SETQ(VERT,{VNEXT,FACE,EDGE.,VERT})
	CAME 1,VERT0↔GO L2

;LAST VERTEX OF THE LAMINA.
	ALT 1,1↔SETQ(EDGE.,{MKFE,1,FACE.,VERT.})
	LAC E.,EDGE.
	SKIPE 1,ENEXT
	GO[
	JALT(1,E.)
	CAR(1)↔DIP(E.);						**
	NFACE F.,E.↔DAC F.,FACE.↔GO L3]
	LAC 1,FNEXT↔PAF. 1,E.
	LAC F,FACE↔NAF. F,E.
	NFACE F.,E.↔DAC F.,FACE.↔GO L3

;NEXT VERTEX OF THE LAMINA.
L2:	SETQ(VERT.,{MKEV,FACE.,VERT.})
	LAC V,VERT↔JALTV(V,1)
	PED E.,1↔DAC E.,EDGE.
	SKIPE 1,ENEXT
	GO[JALT(1,E.)
	CAR(1)↔DIP(E.);						**
	GO L1]
	LAC F,FACE↔PAF. F,E.
	LAC 1,FNEXT↔NAF. 1,E.
	GO L1

L3:	CALL(EVERT,BODYIN)

;TRACE OUT ALL THE FACES CONNECTED TO THIS BODY.
L4:	LAC 1,FACE.
	TEST 1,FBIT
	GO[LAC 1,BODYIN↔POP1J]		;RETURN THE BODY.
	CALL(FTRACE,FACE.)
	LAC 1,FACE.
	PFACE 1,1
	DAC 1,FACE.
	GO L4
ENDR BTRACE;3/8/73(BGB)----------------------------------------------
SUBR(FTRACE)F.		FACE TRACE.
COMMENT ⊗------------------------------------------------------------
⊗↔	GO L0
	DECLARE{F,F.,E,E.,V,V.,U,U.,V0,F2.}

;GET THE FIRST EDGE AND ITS FRIENDS.
L0:	LAC 1,ARG1↔DAC 1,F.
	PED 1,1↔DAC 1,E.
	CALL(VCW,E.,F.)↔ALT 1,1↔DAC 1,V0
	CALL(VCCW,E.,F.)↔ALT 1,1↔DAC 1,V
	LAC 2,E.↔ALT 1,2↔DAC 1,E
	JUMPN 1,[
		CALL(OTHER,E.,F.)
		ALT 1,1
		CALL(OTHER,E,1)
		GO .+5]
	PAF 1,2↔PFACE 0,2
	CAME 0,F.↔NAF 1,2
	DAC 1,F↔LAC 2,F.
	JALT(1,2)

L1:	
	LAC 1,V↔CAMN 1,V0↔POP1J		;EXIT.
	DAC 1,U
	SETQ(V,{VNEXT,F,E.,V})
	SETQ(E.,{ECCW,E.,F.})
	SETQ(V.,{VCCW,E.,F.})

;MAKE SPUR.
	LAC 1,V↔ALT 1,1↔JUMPN 1,L2
	LAC 1,U↔ALT 1,1
	SETQ(V.,{MKEV,F.,1})
	LAC 2,V↔JALTV(2,1)
	PED 1,1↔DAC 1,E.
	SKIPE 2,ENEXT↔GO[JALT(2,1)↔GO L1]
	LAC 2,FNEXT↔NAF. 2,1
	LAC 2,F↔PAF. 2,1↔GO L1

;SPLIT FACE.
L2:	CAMN 1,V.↔GO L1		;SKIP V.≠ALT(V).
	CALL(LINKED,1,F.)
	JUMPE 1,L3		;JUMP WHEN NOT LINKED.

	LAC 1,V↔ALT 1,1
	LAC 2,U↔ALT 2,2
	SETQ(E.,{MKFE,2,F.,1})
	SKIPE 2,ENEXT↔GO[JALT(2,1)↔GO L1]
	LAC 2,FNEXT↔NAF. 2,1
	LAC 2,F↔PAF. 2,1↔GO L1

;MAKE WASP FACE.
L3:	LAC 1,V↔ALT 1,1↔DAC 1,V.
	LAC 1,U↔ALT 1,1↔DAC 1,U.
	LAC 1,F.↔PFACE 1,1↔DAC 1,F2.
	JUMPE 1,[FATAL({WASP LINK F2.=0.})]
	SETQ(E.,{GLUEE,F.,U.,F2.,V.})
	SKIPE 2,ENEXT↔GO[JALT(2,1)↔GO L1]
	LAC 2,FNEXT↔PAF. 2,1
	LAC 2,F↔NAF. 2,1
	GO L1
ENDR FTRACE;3/8/73(BGB)----------------------------------------------
SUBR(BIN,B1,B2)		COMPUTE BODY OF INTERSECTION.
COMMENT ⊗------------------------------------------------------------
⊗↔
	LAC 1,B1↔TEST 1,BBIT↔POP2J↔CALL(FACOEF,1,[0])
	LAC 1,B2↔TEST 1,BBIT↔POP2J↔CALL(FACOEF,1,[0])
	LAC 1,B1↔PVT 1,1↔TEST 1,VBIT↔GO .+3↔DZM ZPP(1)↔GO .-5
	LAC 1,B2↔PVT 1,1↔TEST 1,VBIT↔GO .+3↔DZM ZPP(1)↔GO .-5

;COMPARE ALL THE EDGES OF ONE WITH ALL THE FACES OF THE OTHER.
;THIS N SQUARED PROCESS MAY SOMEDAY BE REPLACED WITH AN OCCULT MODE.
	LAC 1,B2
L1:	PED 1,1↔TEST 1,EBIT↔GO L2-1
	LAC 2,B1↔PFACE 2,2↔TESTZ 2,FBIT↔GO[
	CALL(COMPFE,2,1)↔POP P,1↔POP P,2↔GO .-3]↔GO L1

	LAC 1,B1
L2:	PED 1,1↔TEST 1,EBIT↔GO L3
	LAC 2,B2↔PFACE 2,2↔TESTZ 2,FBIT↔GO[
	CALL(COMPFE,2,1)↔POP P,1↔POP P,2↔GO .-3]↔GO L2

L3:	CALL(GETSURV,B1)↔GO L4
	CALL(GETSURV,B2)↔GO L4
	GO L5

L4:	CALL(QHOLE,1)		;CHECK OUT A POTENTIAL HOLE.
	GO L3			;NO HOLE YET.
	CALL(KLSURV,B1)		;HOLE FACE WAS PYRAMID'ED.
	CALL(KLSURV,B2)		;START OVER.
	GO BIN
L5:	LAC 1,B1
	NVT 1,1↔TESTZ 1,VBIT↔GO[
		TEST 1,SURBIT↔GO .-3
		ALT 0,1↔SKIPE↔GO .-3
		CALL(BTRACE,1,1)
		DAC 1,B#
		POP P,1↔GO .-3]

	LAC 1,B2
	NVT 1,1↔TESTZ 1,VBIT↔GO[
		TEST 1,SURBIT↔GO .-3
		ALT 0,1↔SKIPE↔GO .-3
		CALL(BTRACE,1,1)
		POP P,1↔GO .-3]
	LAC 1,B
	POP2J
ENDR BIN;3/7/73(BGB)-------------------------------------------------
SUBR(SOLANG)V 		SOLID ANGLE OF A SURFACE VERTEX.
COMMENT ⊗------------------------------------------------------------
⊗↔	EXTERN ACOS,DISTANCE,TWOPI
	ACCUMULATORS{F,V}

	LAC 1,ARG1↔DAC 1,V0
	PED 1,1↔DAC 1,E
	SETQ(F1,{FCCW,E,V0})↔SETQ(V1,{OTHERV,F1,V0})
	SETQ(F2,{FCW,E,V0})↔ SETQ(V2,{OTHERV,F2,V0})

	CALL(DISTANCE,V1,V0)↔PUSH P,1		;L1
	CALL(DISTANCE,V2,V0)↔PUSH P,1		;L2
	CALL(DISTANCE,V1,V2)↔FMPR 1,1↔MOVNS 1	;L3

;ANGLE ← ACOS((L1*L1 + L2*L2 - L3*L3)/(2*L1*L2)).
	POP P,2↔POP P,3
	LAC 2↔FMPR 3↔FSC 1
	FMPR 2,2↔FMPR 3,3
	FADR 1,2↔FADR 1,3
	FDVR 1,0
	CALL(ACOS,1)↔PUSH P,1

	LAC V,V2↔LAC F,F1
	LAC 0,XWC(V)↔FMPR 0,AA(F)
	LAC 1,YWC(V)↔FMPR 1,BB(F)↔FADR 0,1
	LAC 1,ZWC(V)↔FMPR 1,CC(F)↔FADR 0,1
	POP P,1
	CAML KK(F)↔POP1J↔MOVNS 1
	FADR TWOPI↔POP1J	;REFLEX ANGLE.
DECLARE{V0,V1,V2,E,F1,F2}
ENDR SOLANG;3/23/73(BGB)---------------------------------------------
SUBR(KLSURV)B		KILL SURFACE VERTICES OF A BODY.
COMMENT ⊗------------------------------------------------------------
⊗↔	ACCUMULATORS{V}
	LAC V,ARG1
L:	NVT V,V↔CAMN V,ARG1↔POP1J
	TEST V,SURBIT↔GO L
	NVT V,V↔PUSH P,V↔PVT V,V
	CALL(KLEV↑,V)↔POP P,V
	GO L+1
ENDR KLSURV;3/23/73(BGB)---------------------------------------------

SUBR(OKSURV)V		MARK A SURFACE LOOP AND MAKE ITS LIST.
COMMENT ⊗------------------------------------------------------------
⊗↔	V←←2
	LAC V,ARG1↔PED 1,V
	PFACE 1,1↔DAC 1,FACE#		;FACE BEGLONG TO V.
	QFACE 1,V↔DAC 1,OLDQF#		;FACE PIERCED BY V.
L:	MARK V,OKBIT↔PUSH P,V
	CALL(OTHERV,FACE,V)		;FOLLOW SURV LOOP ACROSS.
	POP P,V
	CAMN 1,ARG1↔GO[
	SETZ↔ALT2. 0,V↔POP1J]		;NIL AT END OF LIST.
	ALT2. 1,V↔DAC 1,V		;OLDE V POINTS AT NEW V.
	QFACE 0,V↔LAC 1,FACE		;NEXT FACE.
	CAME 0,OLDQF↔LAC 1,OLDQF
	DAC 0,OLDQF↔PED 0,V
	SETQ(FACE,{OTHER,0,1})
	GO L
ENDR OKSURV;3/23/73(BGB)---------------------------------------------


SUBR(GETSURV)B	GET AN UNMARKED SURFACE VERTEX OF A BODY OR SKIP.
COMMENT ⊗------------------------------------------------------------
⊗↔	LAC 1,ARG1
L:	NVT 1,1
	CAMN 1,ARG1
	GO[AOS(P)↔POP1J]
	TEST 1,SURBIT↔GO L
	TESTZ 1,OKBIT↔GO L
	POP1J
ENDR GETSURV;3/23/73(BGB)--------------------------------------------
SUBR(QHOLE)V		 DETECT AND PYRAMID POTENTIAL PIERCE HOLES.
COMMENT ⊗------------------------------------------------------------
⊗↔	EXTERN PYRAMID,PI
	V←←2
	CALL(OKSURV,ARG1)
;SECOND TIME AROUND - LOOK FOR DIFFERENT Q-FACES.
	LAC V,ARG1
	QFACE 1,V↔DAC 1,QF#
L1:	ALT2 V,V↔JUMPE V,L2
	QFACE 0,V↔CAME 0,QF↔POP1J	;EXIT NO HOLE.
	GO L1
L2:	DZM A#↔DZM N#↔DZM X#↔DZM Y#↔DZM Z#

;THIRD TIME AROUND - TAKE SUM OF SOLID INTERIOR ANGLES.
	LAC V,ARG1
L3:	LAC XWC(V)↔FADRM X
	LAC YWC(V)↔FADRM Y
	LAC ZWC(V)↔FADRM Z
	AOS N↔PUSH P,V
	CALL(SOLANG,V)↔FADRM 1,A
	POP P,V↔ALT2 V,V
	SKIPE V↔GO L3

	LAC 0,N↔FLOAT↔DAC 0,N
	FSBRI(2.0)↔FMPR PI↔FSBR A
L4:	MOVMS↔CAMGE[0.01]↔POP1J		;EXIT - NO HOLE.
	CALL(PYRAMID,QF)
	LAC X↔FDVR N↔DAC XWC(1)
	LAC Y↔FDVR N↔DAC YWC(1)
	LAC Z↔FDVR N↔DAC ZWC(1)
	PED 2,1↔DAC 2,3↔DAC 1,4
L5:	MARK 2,DARKEN↔SETQ(2,{ECCW,2,4})↔CAME 2,3↔GO L5
	AOS(P)↔POP1J			;SKIP EXIT - HOLE.
ENDR QHOLE;3/23/73(BGB)----------------------------------------------
SUBR(BUN)B1,B2			BODY UNION.
COMMENT ⊗------------------------------------------------------------
⊗↔	CALL(EVERT,ARG1)
	CALL(EVERT,ARG2)
	CALL(BIN,ARG2,ARG2)
	PUSH P,1
	CALL(EVERT,1)
	POP P,1
	POP2J
ENDR BUN;3/10/73(BGB)------------------------------------------------

SUBR(BSUB)B1,B2			BODY SUBTRACTION BNEW ← (B1-B2).
COMMENT ⊗------------------------------------------------------------
⊗↔	CALL(EVERT,ARG1)
	CALL(BIN,ARG2,ARG2)
	POP2J
ENDR BSUB;3/10/73(BGB)-----------------------------------------------
SUBR(MKCVEX)F 		MAKE CONVEX.
COMMENT ⊗------------------------------------------------------------
⊗↔	EXTERN MKFE,KLFE,ECOEF,VCCW,QFEV,ECW
	ACCUMULATORS{F,E0,V,CNT,N,S,E,W,YMAX,YMIN,XMAX,XMIN}

;GET EXTREMA VERTICES.
MKCVX.:
	LAC F,ARG1↔DAC F,FACE1
	TEST F,BBIT↔GO L0
L00:	PFACE F,F↔CAMN F,ARG1↔POP1J
	PUSH P,F↔CALL(MKCVEX,F)↔POP P,F↔GO L00
L0:	PED E0,F↔DAC E0,EDGE0
	LACI CNT,1
	SLACI YMAX,400000
	SLACI XMAX,400000
	SETCM YMIN,YMAX
	SETCM XMIN,XMAX

L1:	SETQ(V,{VCCW,E0,F})
	CAMGE YMAX,YPP(V)↔GO[LAC YMAX,YPP(V)↔LAC N,V↔GO .+1]
	CAMGE XMAX,XPP(V)↔GO[LAC XMAX,XPP(V)↔LAC E,V↔GO .+1]
	CAMLE YMIN,YPP(V)↔GO[LAC YMIN,YPP(V)↔LAC S,V↔GO .+1]
	CAMLE XMIN,XPP(V)↔GO[LAC XMIN,XPP(V)↔LAC W,V↔GO .+1]
	SETQ(E0,{ECCW,E0,F})
	CAME E0,EDGE0↔AOJA CNT,L1

;EXIT IF FACE1 IS ALREADY A TRIANGLE (OR LESS).
L1B:	CAIG CNT,3↔POP1J
	GO L6
;--------------------------------------------------------------------
;LOP OFF THE POINT WITH THE SMALLEST ANGLE ≡ LARGEST COSINE.
L5:	
	LAC V,ARG1↔DAC V,VERT2
	SETQ(EDGE1,{ECCW,VERT2,FACE1})
	PVT 0,1↔CAMN 0,V↔GO .+3
	CALL(INVERT,1)↔NVT 0,1↔DAC VERT3
	SETQ(EDGE3,{ECW,VERT2,FACE1})
	PVT 0,1↔CAMN 0,V↔GO .+3
	CALL(INVERT,1)↔NVT 0,1↔DAC VERT1
	CALL(ECOEF,EDGE1)
	CALL(ECOEF,EDGE3)
	LAC 2,EDGE1↔LAC 3,EDGE3
	LAC 1,AA(2)↔FMPR 1,AA(3)
	LAC 0,BB(2)↔FMPR 0,BB(3)↔FADR 1,0
	LAC 0,ARG1
	SUB P,[2(2)]↔GO @2(P)			;"POP1J"
;--------------------------------------------------------------------
L6:	CALL(,N,S,E,W)
	SLACI(<-2.0>)↔DAC TMP
	CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
	CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
	CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
	CALL(L5)↔CAMGE 1,TMP↔GO .+3↔DAC VERT0↔DAC 1,TMP
	CALL(L5,VERT0)

	SETQ(EDGE2,{MKFE,VERT1,FACE1,VERT3})
	MARK 1,DARKEN+NSHARP
	NFACE 1,1↔DAC 1,FACE2
	CALL(FACOEF↑,FACE2,[0])
;SCAN FACE1'S PERIMETER VERT1 TO VERT3.
	HRLOI 377777↔DAC QMIN↔DZM VERT4		;INIT FOR CLOSEST VIOLATOR.
	LAC EDGE2↔DAC EDGE0			;INIT FOR FACE1 PERIMETER SCAN.

L2:	SETQ(EDGE0,{ECCW,EDGE0,FACE1})
	SETQ(VERT0,{VCCW,EDGE0,FACE1})
	CAMN 1,VERT1↔GO L3

;TEST FOR VERTEX WITHIN THE TRIANGLE THAT WE ARE ABOUT TO LOP.
	CALL(WITH3D,FACE2,{XWC(1)},{YWC(1)},{ZWC(1)})
	GO L2	;VERTEX IS NOT WITHIN THE TRIANGLE.

;FIND VERTEX WITHIN TRIANGLE, NEAREST VERT0.
	CALL(DISTANCE↑,VERT0,VERT2)
	CAML 1,QMIN↔GO L2
	DAC 1,QMIN
	LAC VERT0↔DAC VERT4
	GO L2			;CONTINUE THE SCAN.

;WHEN TRIANGLE IS UNVIOLATED THEN ITERATE.
L3:	SKIPE VERT4↔GO L4
	GO MKCVX.

;WHEN TRIANGLE HAS BEEN VIOLATED THEN RECURSE.
L4:	CALL(KLFE,EDGE2)
	CALL(MKFE,VERT2,FACE1,VERT4)
	MARK 1,DARKEN
	NFACE 1,1	;START WORKING ON THE NEW FACE.
	CALL(MKCVEX,1)
	GO MKCVX.	;CONTINUE WORKING ON THE OLDE FACE.

DECLARE{FACE1,FACE2,TMP,QMIN}
DECLARE{EDGE0,EDGE1,EDGE2,EDGE3}
DECLARE{VERT0,VERT1,VERT2,VERT3,VERT4}
DEL:	0.01
ENDR MKCVEX;3/23/73(BGB)---------------------------------------------
SUBR(ESLURP,BODY)	;REMOVE UNNECESSARY EDGES.
COMMENT ⊗------------------------------------------------------------
⊗
	ACCUMULATORS{F1,F2,E1} 
;Calculate face co-efficients for each face.
	CALL(FACOEF↑,BODY,[-1])
;Go backwords  thru ring  of edges  killing any  darkened edges  with
;co-planar faces.
	MOVE E1,BODY
LOOP:	NED E1,E1
	TEST E1,EBIT
	POP1J
	PFACE F1,E1
	NFACE F2,E1
;Compare face co-efficients.  Since it rans thru numerous FMPR's and
;SQRT we can't expect them to be exactly equal.
	FOR @` I ε {XYZ}
<	LAC I`WC(F1)
	FSBR I`WC(F2)
	MOVM 0,0
	CAML 0,[0.000001]
	GO LOOP
>	MOVE 0,E1 
;They're co-planar,  now the angle on each vertex needs to be checked
;to make sure it's less than π radians.
	MARK E1,DARKEN
	PVT 1,E1↔DAC 1,V1
	NVT 1,E1↔DAC 1,V2
;Do PVT
	NCCW 1,E1↔PUSH P,1↔SETQ V3,{OTHER↑,1,V1}
	PCW 1,E1 ↔PUSH P,1↔SETQ V4,{OTHER↑,1,V1}
	PUSH P,E1
	CALL(ANGL3V↑,V3,V1,V2)	;ANGL3V appears to return a value < π
	MOVEM 1,T1 		;so both angles must be summed, instead
	CALL(ANGL3V↑,V2,V1,V4)	;of just angle between CW and CCW edges.
	FADR 1,T1
	POP P,E1
	CALL DIAGNS,E1
	CAML 1,PI↑
	GO LOOP
;Do NVT
	PCCW 1,E1↔PUSH P,1↔SETQ V3,{OTHER↑,1,V2}
	NCW 1,E1 ↔PUSH P,1↔SETQ V4,{OTHER↑,1,V2}
	PUSH P,E1
	CALL(ANGL3V↑,V3,V2,V1)
	MOVEM 1,T1
	CALL(ANGL3V↑,V1,V2,V4)
	FADR 1,T1
	POP P,E1
	CALL DIAGNS,E1
	CAML 1,PI↑
	GO LOOP
;We found an unneeded edge, kill it!
	NED 0,E1
	PUSH P,0
	CALL(KLFE↑,E1)
	POP P,E1
	GO LOOP+1
DECLARE{V1,V2,V3,V4,T1}
ENDR ESLURP;8/23/73(TVR)---------------------------------------------
;DIAGONOSTIC DISPLAY.
SUBR(DIAGNS,E1,E2,E3)
	POP3J
	PUSHACS
	FDVR 1,PI↑
	FMPRI 1,(<180.0>)
	PUSH P,1
	CALL(DPYSET↑,DPYBUF↑)
	CALL(DPYBIG↑,[4])
	CALL(AIVECT↑,[-600],[-300])
	CALL(DPYSTR↑,[[ASCIZ/Angle = /]])
	CALL(FLODPY↑,[3])
	CALL(EDPY↑,E1)
	CALL(EDPY,E2)
	CALL(EDPY,E3)
	CALL(DPYOUT↑,[16])
	CALL(GEODPY↑)
	SNEAKW
	CAIE 175
	INCHRW
	POPACS
	POP3J
ENDR DIAGNS;---------------------------------------------------------
XTEST↑:	MOVE 1,PDLPTR↑↔PUSH P,(1)↔PUSHJ P,ESLURP
	SNEAKW↔CAIN 175↔INCHRW↔UPGIOT 16,[0↔0]↔JCALL GEODPY↑
END